VERSION 5.00
Object = "{CDE57A40-8B86-11D0-B3C6-00A0C90AEA82}#1.0#0"; "MSDATGRD.OCX"
Begin VB.Form frmMPS 
   BackColor       =   &H00FFFFFF&
   Caption         =   "Multi-Piece Shipment"
   ClientHeight    =   6150
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   10815
   Icon            =   "frmMPS.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   ScaleHeight     =   6150
   ScaleWidth      =   10815
   StartUpPosition =   1  'CenterOwner
   Begin VB.Timer timerMPSCaption 
      Enabled         =   0   'False
      Interval        =   200
      Left            =   405
      Top             =   5715
   End
   Begin VB.CommandButton cmdViewSigReq 
      Appearance      =   0  'Flat
      BackColor       =   &H00E0E0E0&
      Caption         =   "&View/Edit"
      Height          =   255
      Left            =   9120
      MaskColor       =   &H0080C0FF&
      Style           =   1  'Graphical
      TabIndex        =   32
      Top             =   1860
      UseMaskColor    =   -1  'True
      Width           =   960
   End
   Begin VB.CheckBox f1208 
      BackColor       =   &H00FFFFFF&
      Caption         =   "Signature Service"
      Height          =   255
      Left            =   6960
      TabIndex        =   31
      Top             =   1860
      Width           =   2055
   End
   Begin VB.CheckBox chkPrintAsAdd 
      BackColor       =   &H00FFFFFF&
      Caption         =   "Print As Packages Are Added"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   4020
      TabIndex        =   13
      Top             =   2700
      Width           =   2835
   End
   Begin VB.ComboBox cboBoxName 
      Height          =   315
      Left            =   3780
      TabIndex        =   3
      Top             =   1560
      Width           =   1335
   End
   Begin VB.CommandButton cmdShip 
      Appearance      =   0  'Flat
      BackColor       =   &H00C0E0FF&
      Caption         =   "Ship (F12)"
      Height          =   315
      Left            =   3000
      MaskColor       =   &H0080C0FF&
      Style           =   1  'Graphical
      TabIndex        =   14
      Top             =   5700
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdClose 
      Appearance      =   0  'Flat
      BackColor       =   &H00E0E0E0&
      Cancel          =   -1  'True
      Caption         =   "OK"
      Height          =   315
      Left            =   6600
      MaskColor       =   &H0080C0FF&
      Style           =   1  'Graphical
      TabIndex        =   16
      Top             =   5700
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CheckBox f3018 
      BackColor       =   &H00FFFFFF&
      Caption         =   "Non-Standard Packaging"
      Height          =   285
      Left            =   6960
      TabIndex        =   11
      Top             =   1560
      Width           =   2415
   End
   Begin VB.CommandButton cmdDelete 
      Appearance      =   0  'Flat
      BackColor       =   &H00E0E0E0&
      Caption         =   "&Delete All"
      Height          =   315
      Left            =   4800
      MaskColor       =   &H0080C0FF&
      Style           =   1  'Graphical
      TabIndex        =   15
      Top             =   5700
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.TextBox txtNoPkgs 
      Height          =   315
      Left            =   2040
      TabIndex        =   2
      Text            =   "1"
      Top             =   1200
      Width           =   735
   End
   Begin VB.CommandButton cmdAddMPS 
      Appearance      =   0  'Flat
      BackColor       =   &H00E0E0E0&
      Caption         =   "&Add To Shipment"
      Default         =   -1  'True
      Height          =   315
      Left            =   6960
      MaskColor       =   &H0080C0FF&
      Style           =   1  'Graphical
      TabIndex        =   12
      Top             =   2220
      UseMaskColor    =   -1  'True
      Width           =   1455
   End
   Begin VB.TextBox f3057 
      Height          =   315
      Left            =   6960
      TabIndex        =   10
      Top             =   1200
      Width           =   3135
   End
   Begin VB.TextBox f3056 
      Height          =   315
      Left            =   6960
      TabIndex        =   9
      Top             =   840
      Width           =   3135
   End
   Begin VB.TextBox f25 
      Height          =   315
      Left            =   6960
      TabIndex        =   8
      Top             =   480
      Width           =   3135
   End
   Begin VB.TextBox f26 
      Height          =   315
      Left            =   2040
      TabIndex        =   7
      Top             =   1920
      Width           =   1095
   End
   Begin VB.TextBox f59 
      Height          =   315
      Left            =   2040
      TabIndex        =   4
      Top             =   1560
      Width           =   375
   End
   Begin VB.TextBox f58 
      Height          =   315
      Left            =   2640
      TabIndex        =   5
      Top             =   1560
      Width           =   375
   End
   Begin VB.TextBox f57 
      Height          =   315
      Left            =   3240
      TabIndex        =   6
      Top             =   1560
      Width           =   375
   End
   Begin VB.TextBox f1670 
      Height          =   315
      Left            =   2025
      TabIndex        =   1
      Top             =   855
      Width           =   735
   End
   Begin MSDataGridLib.DataGrid grdMPS 
      Height          =   2535
      Left            =   360
      TabIndex        =   27
      TabStop         =   0   'False
      ToolTipText     =   "To Delete a Package highlight the row and press the Delete key."
      Top             =   3015
      Width           =   10095
      _ExtentX        =   17806
      _ExtentY        =   4471
      _Version        =   393216
      AllowUpdate     =   -1  'True
      ForeColor       =   0
      HeadLines       =   2
      RowHeight       =   15
      TabAction       =   2
      WrapCellPointer =   -1  'True
      AllowAddNew     =   -1  'True
      AllowDelete     =   -1  'True
      BeginProperty HeadFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Caption         =   "Total Packages: 0"
      ColumnCount     =   2
      BeginProperty Column00 
         DataField       =   ""
         Caption         =   ""
         BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
            Type            =   0
            Format          =   ""
            HaveTrueFalseNull=   0
            FirstDayOfWeek  =   0
            FirstWeekOfYear =   0
            LCID            =   1033
            SubFormatType   =   0
         EndProperty
      EndProperty
      BeginProperty Column01 
         DataField       =   ""
         Caption         =   ""
         BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
            Type            =   0
            Format          =   ""
            HaveTrueFalseNull=   0
            FirstDayOfWeek  =   0
            FirstWeekOfYear =   0
            LCID            =   1033
            SubFormatType   =   0
         EndProperty
      EndProperty
      SplitCount      =   1
      BeginProperty Split0 
         BeginProperty Column00 
         EndProperty
         BeginProperty Column01 
         EndProperty
      EndProperty
   End
   Begin VB.TextBox f1 
      Height          =   315
      Left            =   2040
      TabIndex        =   0
      TabStop         =   0   'False
      Top             =   480
      Width           =   2415
   End
   Begin VB.Line Line6 
      BorderColor     =   &H000080FF&
      BorderWidth     =   2
      X1              =   5400
      X2              =   5400
      Y1              =   240
      Y2              =   2280
   End
   Begin VB.Label Label10 
      BackColor       =   &H00FFFFFF&
      Caption         =   "Reference and Special Svc Information"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000080FF&
      Height          =   255
      Left            =   5760
      TabIndex        =   30
      Top             =   135
      Width           =   3735
   End
   Begin VB.Line Line3 
      BorderColor     =   &H000080FF&
      BorderWidth     =   2
      X1              =   5760
      X2              =   10440
      Y1              =   120
      Y2              =   120
   End
   Begin VB.Label lblf1 
      Alignment       =   1  'Right Justify
      BackColor       =   &H00FFFFFF&
      Caption         =   "Order ID:"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   180
      TabIndex        =   29
      Top             =   540
      Width           =   1755
   End
   Begin VB.Label lblNoPkgs 
      Alignment       =   1  'Right Justify
      BackColor       =   &H00FFFFFF&
      Caption         =   "# of Pkgs to Add:"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Index           =   1
      Left            =   240
      TabIndex        =   28
      Top             =   1260
      Width           =   1695
   End
   Begin VB.Label Label35 
      Alignment       =   1  'Right Justify
      BackColor       =   &H00FFFFFF&
      Caption         =   "P.O. Number:"
      Height          =   255
      Left            =   5760
      TabIndex        =   26
      Top             =   900
      Width           =   1095
   End
   Begin VB.Label Label25 
      Alignment       =   1  'Right Justify
      BackColor       =   &H00FFFFFF&
      Caption         =   "Invoice Number:"
      Height          =   255
      Left            =   5640
      TabIndex        =   25
      Top             =   1260
      Width           =   1215
   End
   Begin VB.Label Label22 
      Alignment       =   1  'Right Justify
      BackColor       =   &H00FFFFFF&
      Caption         =   "Reference:"
      Height          =   255
      Left            =   5760
      TabIndex        =   24
      Top             =   540
      Width           =   1095
   End
   Begin VB.Label Label14 
      Alignment       =   1  'Right Justify
      BackColor       =   &H00FFFFFF&
      Caption         =   "Declared Value:"
      Height          =   255
      Index           =   0
      Left            =   120
      TabIndex        =   23
      Top             =   1980
      Width           =   1815
   End
   Begin VB.Label Label16 
      BackColor       =   &H00FFFFFF&
      Caption         =   "L x W x H in."
      ForeColor       =   &H000080FF&
      Height          =   255
      Index           =   0
      Left            =   3840
      TabIndex        =   22
      Top             =   1620
      Width           =   1095
   End
   Begin VB.Label Label17 
      Alignment       =   1  'Right Justify
      BackColor       =   &H00FFFFFF&
      Caption         =   "Package Dimensions:"
      Height          =   255
      Index           =   0
      Left            =   120
      TabIndex        =   21
      Top             =   1620
      Width           =   1815
   End
   Begin VB.Label Label24 
      Alignment       =   2  'Center
      BackColor       =   &H00FFFFFF&
      Caption         =   "x"
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Index           =   0
      Left            =   2400
      TabIndex        =   20
      Top             =   1590
      Width           =   255
   End
   Begin VB.Label Label73 
      Alignment       =   2  'Center
      BackColor       =   &H00FFFFFF&
      Caption         =   "x"
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Index           =   0
      Left            =   3000
      TabIndex        =   19
      Top             =   1590
      Width           =   255
   End
   Begin VB.Label Label19 
      Alignment       =   1  'Right Justify
      BackColor       =   &H00FFFFFF&
      Caption         =   "Package Weight:"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Index           =   0
      Left            =   240
      TabIndex        =   18
      Top             =   900
      Width           =   1695
   End
   Begin VB.Label lblPackage 
      BackColor       =   &H00FFFFFF&
      Caption         =   "Package Information"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000080FF&
      Height          =   255
      Left            =   360
      TabIndex        =   17
      Top             =   135
      Width           =   2055
   End
   Begin VB.Line Line1 
      BorderColor     =   &H000080FF&
      BorderWidth     =   2
      X1              =   360
      X2              =   5040
      Y1              =   120
      Y2              =   120
   End
End
Attribute VB_Name = "frmMPS"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False


' 2009-02-10, JFW, Keep MPS packages sorted.  Afterward found that Access db needed Compact and Repair.
    
    
    
Option Explicit

'General Section
Public WithEvents g_rsMPS As ADODB.Recordset
Attribute g_rsMPS.VB_VarHelpID = -1
Public g_strOrderID As String
'

Private Sub cboBoxName_Change()
    
    On Error GoTo EH
    
    '20080122-03 Update box DIMs after lost focus
    Call UpdateBoxDims(f57, f58, f59, cboBoxName.Text)
    
    Exit Sub
EH:
    MsgBox Err.Description, vbCritical, "frmMPS:cboBoxName_Change"

End Sub

Private Sub cboBoxName_Click()
    
    On Error GoTo EH
    
    '20080122-03 Update box DIMs after lost focus
    Call UpdateBoxDims(f57, f58, f59, cboBoxName.Text)
    
    Exit Sub
EH:
    MsgBox Err.Description, vbCritical, "frmMPS:cboBoxName_Click"

End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : cboBoxName_LostFocus()
' DateTime  : 20080122-03
' Purpose   : Puts date selected on calendar in ShipDate field.
'---------------------------------------------------------------------------------------
'
Private Sub cboBoxName_LostFocus()
    
    On Error GoTo EH
    
    '20080122-03 Update box DIMs after lost focus
    Call UpdateBoxDims(f57, f58, f59, cboBoxName.Text)
    
    Exit Sub
EH:
    MsgBox Err.Description, vbCritical, "frmMPS:cboBoxName_LostFocus"

End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : chkPrintAsAdd_Click()
' DateTime  : 7/9/2004
' Purpose   : Changes the caption on these buttons depending on whether or not you're
'             printing as pkgs are added.
'---------------------------------------------------------------------------------------
'
Private Sub chkPrintAsAdd_Click()
    Dim intRet As Integer
    
    cmdAddMPS.Caption = IIf(chkPrintAsAdd = 1, "&Print", "&Add To Shipment")
    If chkPrintAsAdd = 0 Then cmdAddMPS.Enabled = True
    cmdAddMPS.BackColor = IIf(chkPrintAsAdd = 1, &HC0E0FF, &HE0E0E0)
    cmdClose.Caption = IIf(chkPrintAsAdd = 1, "Done", "OK")
    cmdShip.Enabled = IIf(chkPrintAsAdd = 1, False, True)
    cmdShip.BackColor = IIf(chkPrintAsAdd = 1, &HE0E0E0, &HC0E0FF)
    With frmShip
        If (.f27(0) = 1 Or .f27(1) = 1 Or .f27(2) = 1) And chkPrintAsAdd = 1 Then
            intRet = MsgBox("Using this feature with COD will cause separate" & vbCrLf & _
                            "COD shipments each time the Print button is clicked." & vbCrLf & _
                            "Are you sure you wish to use this feature?", vbYesNo, "COD Alert")
            If intRet = vbNo Then chkPrintAsAdd = 0
        End If
    End With
            
End Sub
'---------------------------------------------------------------------------------------
' Procedure : cmdClose_Click()
' DateTime  : 7/9/2004
' Purpose   : Close clicked, hide the form. If printing as pkgs are added clear screens,
'              reset globals, and set MPS boolean to False.
'---------------------------------------------------------------------------------------
'
Private Sub cmdClose_Click()
    
    On Error GoTo EH
    
    If chkPrintAsAdd = 1 Then
        With frmShip
            Call .ClearShipFields
            Call ClearGlobalVars
            g_blnMPS = False
            .StatusBar1.Panels(2) = "Shipment Complete"
        End With
    End If
    
    Me.Hide
    
    '20070625-01 Added MPS functionality to Service Quote
    If g_blnIsQuote Then
        frmQuote.SetFocus
    Else
        Call UpdateShip
        If frmShip.Visible Then frmShip.SetFocus
    End If
    
    Exit Sub

EH:
    MsgBox Err.Description, vbCritical, "frmMPS:cmdClose_Click"
    If False Then
        Resume
    End If
    
End Sub
'---------------------------------------------------------------------------------------
' Procedure : cmdDelete_Click()
' DateTime  : 3/19/2004
' Purpose   : Verifes user wished to delete all pieces in a shipment and if yes, calls
'           : DeleteMPS and UpdateMPSGrid.
'---------------------------------------------------------------------------------------
'
Private Sub cmdDelete_Click()
    Dim intRet As Integer

    intRet = MsgBox("Are you sure you wish to delete all pieces in this shipment?", vbYesNo, "Confirm Delete All")
    If intRet = vbYes Then
        Call DeleteMPS(f1)
        Call UpdateMPSGrid(f1)
        frmShip.f116.Text = "1"
    End If
    timerMPSCaption.Enabled = True
        
End Sub
'---------------------------------------------------------------------------------------
' Procedure : cmdAddMPS_Click()
' DateTime  : 3/19/2004
' Purpose   : Adds a record to the MPS table for # of pkgs entered then clears some of
'           : the text fields and call UpdateMPSGrid
'---------------------------------------------------------------------------------------
'
Private Sub cmdAddMPS_Click()
    Dim i As Integer
    
    On Error GoTo EH
    
    'Check to ensure # of pkgs is entered
    If Val(txtNoPkgs) < 1 Then
        MsgBox "Please enter the # of Pkgs to Add.", vbExclamation, "MPS Add Error"
        txtNoPkgs.SetFocus
        Exit Sub
    End If
    
    'Don't add if Printing As Adding and no weight entered
    If chkPrintAsAdd = 0 Or Val(f1670) > 0 Then
        'Loop through # of pkgs and add the data to the database
        For i = 1 To txtNoPkgs
            If AddMPSToMDB(f1) < 1 Then
                'Error!
                MsgBox "Package NOT added to database, please try again.", vbApplicationModal Or vbCritical
            End If
        Next i
    End If
    
    
    'Clear some of the fields
    f1670 = ""
    f57 = ""
    f58 = ""
    f59 = ""
    cboBoxName = ""
    f26 = ""
    txtNoPkgs = "1"
    
    'Update the DataGrid Control
    Call UpdateMPSGrid(f1)
    
    'If Print As Pkgs Are Added is selected, Ship labels and delete entries from MDB
    If chkPrintAsAdd Then
        Call cmdShip_Click
    End If
    
    'If a scale is connected set focus to OrderID else set it to Weight field
    If f1.Text = "" Then
        f1.SetFocus
    ElseIf frmSetup.chkScaleConnected = 1 Then
        ' 2010-06-03, JFW, order ID should be set.
        txtNoPkgs.SetFocus
    Else
        f1670.SetFocus
    End If
    
    Exit Sub

EH:
    MsgBox Err.Description, vbCritical, "frmMPS:cmdAddMPS"
End Sub
'---------------------------------------------------------------------------------------
' Procedure : AddMPSToMDB()
' DateTime  : 3/19/2004
' Purpose   : Adds a record to the MPS database and returns the number of
'             records affected...usually '1'.
'---------------------------------------------------------------------------------------
'
Public Function AddMPSToMDB(ByVal str1 As String) As Long
    Dim strSQL As String
    ' 2009-02-10, JFW, Keep MPS packages sorted
    Static strTimeStamp As String
    Static intTimeStampPlus As Integer
    
    On Error GoTo EH
    
    'Set the return value to zero in case of a runtime error
    AddMPSToMDB = 0
    
    'Build and execute the SQL statement
    strSQL = "INSERT into MPS VALUES (" & SingleQuotes(str1) & ","
    strSQL = strSQL & SingleQuotes(f1670) & ","
    '--------------------------------------------------
    '05/10/06 Updated for new DIM structure
    If IsNumeric(f57) Then
        strSQL = strSQL & SingleQuotes(f57) & ","
    Else
        strSQL = strSQL & "'',"
    End If
    If IsNumeric(f58) Then
        strSQL = strSQL & SingleQuotes(f58) & ","
    Else
        strSQL = strSQL & "'',"
    End If
    If IsNumeric(f59) Then
        strSQL = strSQL & SingleQuotes(f59) & ","
    Else
        strSQL = strSQL & "'',"
    End If
    '--------------------------------------------------
    strSQL = strSQL & SingleQuotes(f26) & ","
    strSQL = strSQL & SingleQuotes(f25) & ","
    strSQL = strSQL & SingleQuotes(f3056) & ","
    strSQL = strSQL & SingleQuotes(f3057) & ","
    strSQL = strSQL & SingleQuotes(f3018) & ","
    If f1208 = 1 Then
        With frmSigReq
            If .f2399(2) Then
                strSQL = strSQL & "'ISR',"
            ElseIf .f2399(3) Then
                strSQL = strSQL & "'DSR',"
            ElseIf .f2399(4) Then
                strSQL = strSQL & "'ASR',"
            End If
        End With
    Else
        strSQL = strSQL & "'',"
    End If
    ' 2009-02-10, JFW, Keep MPS packages sorted
    If strTimeStamp = "" Then
        strTimeStamp = Format(Now, "YYYYMMDD HHNNSS")
        intTimeStampPlus = 0
    ElseIf strTimeStamp = Format(Now, "YYYYMMDD HHNNSS") Then
        intTimeStampPlus = intTimeStampPlus + 1
    Else
        strTimeStamp = Format(Now, "YYYYMMDD HHNNSS")
        intTimeStampPlus = 0
    End If
    strSQL = strSQL & SingleQuotes(strTimeStamp & " " & CStr(intTimeStampPlus)) & ","
    
    strSQL = strSQL & SingleQuotes(g_strComputerName) & ")"
    
    g_connFSMSClient.Execute strSQL, AddMPSToMDB

    Exit Function
EH:
    MsgBox Err.Description, vbCritical, "frmMPS:AddMPSToMDB"
End Function
'---------------------------------------------------------------------------------------
' Procedure : UpdateMPSGrid()
' DateTime  : 3/19/2004
' Purpose   : Update the datagrid for given OrderID. Also assign column captions.
' Call from : Form_Activate, cmdAddMPS_Click, frmShip.f1_LostFocus,
'             cmdDelete_Click,
'---------------------------------------------------------------------------------------
'
Public Sub UpdateMPSGrid(ByVal strOrderID As String)
    Dim strSQL As String
    
    On Error GoTo EH
    
    g_strOrderID = strOrderID
    
    'Build and open the recordset
    strSQL = "SELECT * FROM MPS WHERE f1 = '" & strOrderID & "'"
    strSQL = strSQL & " AND Workstation = '" & g_strComputerName & "'"
    strSQL = strSQL & " order by ShipDate"
    
    If g_rsMPS.State = adStateOpen Then g_rsMPS.Close
    
    g_rsMPS.Open strSQL, g_connFSMSClient, adOpenStatic, adLockOptimistic

    Set grdMPS.DataSource = g_rsMPS
    With grdMPS
        .ClearFields
        .ReBind
        .Columns(0).Caption = "OrderID"
        .Columns(1).Caption = "Pkg Wgt"
        .Columns(2).Caption = "Height"
        .Columns(3).Caption = "Width"
        .Columns(4).Caption = "Length"
        .Columns(5).Caption = "Declared Value"
        .Columns(6).Caption = "Reference"
        .Columns(7).Caption = "PO Number"
        .Columns(8).Caption = "Invoice Number"
        .Columns(9).Caption = "NSP Flag"
        .Columns(10).Caption = "Sig Svc Type"
        .Columns(11).Caption = "Computer"
        .Caption = "Total Packages: " & Str(g_rsMPS.RecordCount)
    End With
    
    Call UpdateShip
    
    timerMPSCaption.Enabled = True

    Exit Sub
    
EH:
    'Added to ignore "Operation not allowed in this context" error
    If Err.number <> 3219 Then
        MsgBox Err.Description, vbCritical, "frmMPS:UpdateMPSGrid"
    End If
End Sub


Private Sub UpdateShip()

    On Error GoTo EH
    
    Dim rsMPSCount As ADODB.Recordset
    Dim rsQuery As String
    
    Set rsMPSCount = New ADODB.Recordset
    rsQuery = "SELECT * FROM MPS WHERE f1 = '" & f1 & "'"
    rsQuery = rsQuery & " AND Workstation = '" & g_strComputerName & "'"
    rsQuery = rsQuery & " order by ShipDate"
    rsMPSCount.Open rsQuery, g_connFSMSClient, adOpenStatic, adLockOptimistic
    
    'Update #pkgs on Ship screen
    If Not (rsMPSCount.BOF Or rsMPSCount.EOF) Then
        '20070625-01 Added MPS functionality to Service Quote
        frmShip.f1670.Text = "0"
        frmShip.f116.Text = "0"
        rsMPSCount.MoveFirst
        Do
            If rsMPSCount.EOF Then Exit Do
            If IsNumeric(rsMPSCount!g_str1670 & "") Then
                frmShip.f1670.Text = CDec(frmShip.f1670.Text) + CDec(rsMPSCount!g_str1670)
                frmShip.f116.Text = CDec(frmShip.f116.Text) + 1
            End If
            rsMPSCount.MoveNext
        Loop
        rsMPSCount.MoveFirst
        If g_blnIsQuote Then
            frmQuote.f116 = Str(rsMPSCount.RecordCount)
        End If
    Else
        ' 2012-01-12, JFW, Allow express number of pieces
        If Not IsNumeric(frmShip.f116.Text) Then
            frmShip.f116.Text = "1"
        End If
        If g_blnIsQuote Then
            If Not IsNumeric(frmQuote.f116.Text) Then
                frmQuote.f116.Text = "1"
            End If
        End If
        ' 2010-02-26, JFW, No, scale might be in effect, leave the wieght.
        ' frmShip.f1670.Text = "1"
    End If
    
    Exit Sub
    
EH:
    DebugPrint Err.Source & ", " & Err.Description
    Debug.Assert False
    If False Then
        Resume
    End If
    
End Sub


'---------------------------------------------------------------------------------------
' Procedure : ShipMPS()
' DateTime  : 3/19/2004
' Purpose   : Call frmShip.AssignTextToGlobal then ShipMPS.
'---------------------------------------------------------------------------------------
'
Private Sub cmdShip_Click()
    
    On Error GoTo EH
    
    f1.SetFocus
    Call UpdateMPSGrid(f1)
    Call UpdateShip

    'Assign main form fields to global vars then ship
    ' 2015-01-02, JFW, Go to Ship ShipButton
    ' Call frmShip.AssignTextToGlobal
    
    Call frmShip.ShipButton
    
    ' 2015-01-02, JFW, Go to Ship ShipButton
'    If BeforeShip Then
'        '8/19/05 Removed ShipCODFirstPiece
'        Call ShipMPS
'
'        If chkPrintAsAdd = 0 Then Me.Hide
'    End If
'
'    If chkPrintAsAdd = 0 Then Me.Hide
    
    Exit Sub
EH:
    MsgBox Err.Description, vbCritical, "frmMPS:cmdShip_Click"
End Sub

Private Sub cmdViewSigReq_Click()
    frmSigReq.Show vbModeless, Me
End Sub

Private Sub f1670_LostFocus()
    Call AfterLostFocus(f1670)
End Sub

Private Sub f25_Change()
    If Left(frmShip.f1274, 2) = "99" Then
        Call CleanSPRef(f25)
        Call CheckLength(f25, 20)
    End If
End Sub

Private Sub Form_Initialize()

    Call Initialize(Me)
    
End Sub

'---------------------------------------------------------------------------------------
' Procedure : Form_KeyUp()
' DateTime  : 2/17/2005
' Purpose   : Check for F12 key
'---------------------------------------------------------------------------------------
'
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    'F12 key pressed, Ship pkg
    If KeyCode = 123 And cmdShip.Enabled = True Then
        Call cmdShip_Click
    End If
End Sub
'---------------------------------------------------------------------------------------
' Procedure : Form_KeyDown()
' DateTime  : 2/17/2005
' Purpose   : Enter key pressed sends a TAB to move to next field
'---------------------------------------------------------------------------------------
'
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    If Not TypeOf Me.ActiveControl Is CommandButton Then
        If Shift = 0 And KeyCode = 13 Then
            SendKeys "{TAB}"
        End If
    End If
End Sub
'---------------------------------------------------------------------------------------
' Procedure : ShipMPS()
' DateTime  : 3/19/2004
' Updated   : 8/22/2005 Removed call to DeleteMPSFromMDB if Printing as Adding and moved
'             it to ParseComplete in frmShip.
' Purpose   : If Ground or FHD clear MPS global vars set in frmShip.AssignTextToGlobal
'           : then call SendData(BuildDOMMPSShipTrans), else if Express ship each MPS
'           : individually by looping through g_rsMPS and calling SendData(BuildDomShipTrans)
'           : for each package.
'---------------------------------------------------------------------------------------
'
Public Sub ShipMPS()
    
    On Error GoTo EH
   
    If g_rsMPS.RecordCount = 0 Then
        MsgBox "There are no Multi-Piece Shipments for this Order." & vbCrLf _
                & "Please enter MPS information or check Indentical Pkgs.", vbExclamation, "Multi-Piece Shipment Error"
        
        'Enable buttons and show status bar error
        With frmShip
            Call .EnableButtons
            .StatusBar1.Panels(2) = "MPS Error"
        End With
        
        Exit Sub
    End If
    g_str1670 = ""
    g_str57 = ""
    g_str58 = ""
    g_str59 = ""
    If Not frmShip.optDocument Then g_str26 = ""
    g_str25 = ""
    g_str3056 = ""
    g_str3057 = ""
    g_str3018 = ""
    g_str2399 = ""
    
    'Added 6/16/05 for Sig Svc
    If f1208 = 1 Then
        g_str1208 = "Y"
    Else
        g_str1208 = ""
    End If
    
    With frmShip
        .StatusBar1.Panels(2) = "Processing..."
        
        If g_str1274 = "99" Then
            Call ShipSmartPost
        '20071029-01 - Allow HazMat MPS - Removed f1331(1) from this statement.
        ' 2008-04-21, JFW, CA DG
        ElseIf .chkIPD = 1 Or .chkIntlIPD = 1 Or .f1331(0) = 1 Or .f1331(3) = 1 Or .f1331(4) = 1 Then  'Or .f1331(1) = 1 Then
            'Used to keep from clearing screen and global vars
            g_blnMPS = True
    
            'Loop through recordset and ship pkgs
            Do Until g_rsMPS.EOF
                'Used to pause until reply received and parsed.
                g_blnComplete = False
                
                g_str1 = g_rsMPS!f1 & ""
                g_str1670 = g_rsMPS!g_str1670 & ""
                g_str57 = g_rsMPS!g_str57 & ""
                g_str58 = g_rsMPS!g_str58 & ""
                g_str59 = g_rsMPS!g_str59 & ""
                g_str26 = g_rsMPS!g_str26 & ""
                g_str25 = g_rsMPS!g_str25 & ""
                
                '01/16/06 Added Intl IPD
                If .chkIPD = 1 Or .chkIntlIPD = 1 Then
                    Call SendData(BuildIPDShipTrans(f1))
                Else
                    Call SendData(BuildDomShipTrans)
                End If
                
                'Pause until reply received and parsed
                Do While Not g_blnComplete
                    DoEvents
                Loop
                
                'If there's an error move to 1st record and exit
                If g_str3 <> "" Then
                    g_rsMPS.MoveFirst
                    Exit Sub
                Else
                    g_rsMPS.MoveNext
                End If
            Loop
            g_blnMPS = False
                    
            'Delete Commodities, MPS, Update status, clear screen and global vars.
            If chkPrintAsAdd = 0 Then
                '20071026-01 Changed the following two lines to pass g_str1 instead of f1
                Call DeleteMPS(g_str1)
                Call UpdateMPSGrid(g_str1)
                .StatusBar1.Panels(2) = "Shipment Complete"
                Call .ClearShipFields
                Call .EnableButtons
                Call ClearGlobalVars
            End If
        ElseIf g_str50 = "US" And g_str117 = "US" And g_str16 <> "PR" Then
            Call SendData(BuildDomMPSShipTrans(g_str1))
        'Added 3/28/06 for Intra-Canada
        ElseIf g_str117 = "CA" And g_str50 = "CA" Then
            If g_str116 = 1 Or frmShip.chkDuplicate = 1 Then
                Call SendData(BuildCADomShipTrans)
            
            'Build Domestic MPS transaction then send it
            Else
            
                If g_str116 > 1 And g_rsMPS.RecordCount > 0 Then
                    g_str1670 = ""
                    g_str57 = ""
                    g_str58 = ""
                    g_str59 = ""
                    g_str26 = ""
                    g_str25 = ""
                    g_str3056 = ""
                    g_str3057 = ""
                    g_str3018 = ""
                    Call SendData(BuildDomMPSShipTrans(g_str1))
                Else
                    Call SendData(BuildCADomShipTrans)
                End If
            End If
        '03/28/06 Changed to ship Intl if shipper country <> recip country
        ElseIf g_str50 <> g_str117 Or (g_str50 = "US" And g_str16 = "PR") Then
            If .optCommodities Then
                Call SendData(BuildIntlMPSShipTrans(g_str1))
            ElseIf .optDocument Then
                Call SendData(BuildIntlDocShipTrans(g_str1))
            End If
        End If
    End With
    
    Exit Sub
EH:
    MsgBox Err.Description, vbCritical, "frmMPS:ShipMPS"
End Sub
'---------------------------------------------------------------------------------------
' Procedure : f1_LostFocus()
' DateTime  : 3/16/2004
' Purpose   : Update datagrid if Order ID is different than the one on frmShip.
'---------------------------------------------------------------------------------------
'
Private Sub f1_LostFocus()
    
    '20070625-01 Added MPS functionality to Service Quote
    If Not g_blnIsQuote And f1 <> frmShip.f1 Then
        Call UpdateMPSGrid(f1)
        Call GetData(f1)
        frmShip.f1 = f1
    End If
        
End Sub
'---------------------------------------------------------------------------------------
' Procedure : f1670_Change()
' DateTime  : 3/16/2004
' Purpose   : Weight is numeric only
'---------------------------------------------------------------------------------------
'
Private Sub f1670_Change()
    
    Call NumericOnly(f1670, True)
    
End Sub
'---------------------------------------------------------------------------------------
' Procedure : f1670_GotFocus()
' DateTime  : 3/16/2004
' Purpose   : If scale is configured, read it
'---------------------------------------------------------------------------------------
'
Private Sub f1670_GotFocus()
    
    On Error GoTo EH
    
    With frmSetup
        If .chkScaleConnected = 1 Then
            f1670 = ReadScale(Right(.cmbScalePort, 1), Left(.cboProtocol, 1))
        Else
            Call SelectAllText(f1670)
        End If
    End With
    
    Exit Sub
EH:
    MsgBox Err.Description, vbCritical, "frmMPS:f1670_GotFocus"

End Sub
'---------------------------------------------------------------------------------------
' Procedure : f26_Change()
' DateTime  : 3/16/2004
' Purpose   : Declared Value is numeric only
'---------------------------------------------------------------------------------------
'
Private Sub f26_Change()
    Call NumericOnly(f26, False)
End Sub
'---------------------------------------------------------------------------------------
' Procedure : f57_Change(), f58_Change(), f59_Change()
' DateTime  : 20080122-03
' Purpose   : Dimensions fields are a max length of 3. Set default text to show dimension
'---------------------------------------------------------------------------------------
'
Private Sub f57_Change()
    On Error GoTo EH
    
    Call CheckLength(f57, 3)
    
    Exit Sub
EH:
    MsgBox Err.Description, vbCritical, "frmMPS:f57_Change"

End Sub

Private Sub f57_LostFocus()
    
    If f57.Text <> Trim(f57.Text) Then f57.Text = Trim(f57.Text)
    If f57 = "" Then f57 = " H "

End Sub

Private Sub f58_Change()
    On Error GoTo EH
    
    Call CheckLength(f58, 3)
    
    Exit Sub
EH:
    MsgBox Err.Description, vbCritical, "frmMPS:f58_Change"

End Sub

Private Sub f58_LostFocus()
    
    If f58.Text <> Trim(f58.Text) Then f58.Text = Trim(f58.Text)
    If f58 = "" Then f58 = " W "

End Sub


Private Sub f59_Change()
    On Error GoTo EH
    
    Call CheckLength(f59, 3)
    
    Exit Sub
EH:
    MsgBox Err.Description, vbCritical, "frmMPS:f59_Change"

End Sub

Private Sub f59_LostFocus()
    
    If f59.Text <> Trim(f59.Text) Then f59.Text = Trim(f59.Text)
    If f59 = "" Then f59 = " L "

End Sub

'---------------------------------------------------------------------------------------
' Procedure : Form_Load()
' DateTime  : 3/16/2004
' Purpose   : Instantiate recordset
'---------------------------------------------------------------------------------------
'
Private Sub Form_Load()
    
    Set g_rsMPS = New ADODB.Recordset
    
    f57 = " H "
    f58 = " W "
    f59 = " L "

End Sub
'---------------------------------------------------------------------------------------
' Procedure : Form_Unload()
' DateTime  : 3/16/2004
' Purpose   : Kills objects
'---------------------------------------------------------------------------------------
'
Private Sub Form_Unload(Cancel As Integer)
    Set grdMPS.DataSource = Nothing
    If g_rsMPS.State = adStateOpen Then g_rsMPS.Close
    Set g_rsMPS = Nothing
End Sub
'---------------------------------------------------------------------------------------
' Procedure : Form_Activate()
' DateTime  : 3/16/2004
' Modified  : 8/18/05 Changed code so that if form loses focus Reference and Dec Val
'             fields won't be cleared.
' Purpose   : Runs when MPS form is active form on screen. Copies default values from
'             form ship and updates datagrid.
'Calls:     : UpdateMPSGrid
'---------------------------------------------------------------------------------------
'
Private Sub Form_Activate()
    On Error GoTo EH
    Dim str1 As String
    
    '20070625-01 Added MPS functionality to Service Quote
    If g_blnIsQuote Then
        f1 = "QUOTE"
        cmdShip.Enabled = False
    Else
       With frmShip
            '8/18/05 Updated - Set values to the same as the 'Ship' screen if blank and
            'Ship screen not blank.
            f26 = IIf(f26 = "", .f26, f26)
            f25 = IIf(f25 = "", .f25, f25)
            f3056 = IIf(f3056 = "", .f3056, f3056)
            f3057 = IIf(f3057 = "", .f3057, f3057)
            '9/8/05 Updated to get CustID
            str1 = IIf(.f1.Visible, .f1, .cboCustID)
    
            If str1 = "" Then
                If .f1.Visible Then
                    .f1.Text = Format(Now, "HHnnss")
                ElseIf .cboCustID.Visible Then
                    .cboCustID.Text = Format(Now, "HHnnss")
                End If
            End If
            f1 = IIf(.f1.Visible, .f1, .cboCustID)
            lblf1.Caption = IIf(.f1.Visible, "Order ID", "Customer ID")
            
            If g_str117 <> "US" Then
                Me.chkPrintAsAdd.Visible = False
                Me.chkPrintAsAdd.Value = 0
            End If
            
        End With
        
'        frmShip.f1.Enabled = False
'        frmShip.cboCustID.Enabled = False
        
        If g_str117 <> Left(frmShip.f50, 2) Then
            Label14(0).Caption = "Carriage Value:"
            Label14(0).FontBold = True
        Else
            Label14(0).Caption = "Declared Value:"
            Label14(0).FontBold = False
        End If
    End If
    
    'Load Box DIMs
    Call LoadBoxDIMsCombos(cboBoxName)
    'Show DIMs combo if there are items in it
    cboBoxName.Visible = IIf(cboBoxName.ListCount > 0, True, False)
    
    'Update the Datagrid just in case
    Call UpdateMPSGrid(f1)
    
    If f1.Text = "" Then
        f1.SetFocus
    Else
        f1670.SetFocus
    End If
    
    Call AfterScreenChange(Me)

    Exit Sub
EH:
    MsgBox Err.Description, vbCritical, "frmMPS:Form_Activate"
End Sub

'---------------------------------------------------------------------------------------
' Procedure : grdMPS_AfterColUpdate()
' DateTime  : 7/15/2004
' Modified  : 8/11/2004
' Change    : Added a check for Null before setting the bookmark. This allows records
'             to be added. Also added error handling.
' Purpose   : This commits the changes immediately after a column has been updated.
'             This keeps users from getting "Operation not allowed in this context" error.
'---------------------------------------------------------------------------------------
'
Private Sub grdMPS_AfterColUpdate(ByVal ColIndex As Integer)
     
    On Error GoTo EH
    
    If grdMPS.Bookmark >= 0 Then
        grdMPS.Bookmark = grdMPS.Bookmark
    End If
    
    timerMPSCaption.Enabled = True
    
    Exit Sub
EH:
    MsgBox Err.Description, vbCritical, "frmMPS:grdMPS_AfterColUpdate"
    
End Sub
'---------------------------------------------------------------------------------------
' Procedure : grdMPS_AfterDelete()
' DateTime  : 3/16/2004
' Purpose   : Update recordcount after a record is deleted.
'---------------------------------------------------------------------------------------
'
Private Sub grdMPS_AfterDelete()
     
     timerMPSCaption.Enabled = True

End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : grdMPS_BeforeDelete()
' DateTime  : 3/19/2004
' Purpose   : Verify user wishes to delete a record in the MPS grid.
'---------------------------------------------------------------------------------------
'
Private Sub grdMPS_BeforeDelete(Cancel As Integer)
    Dim intResult As Integer
    
    intResult = MsgBox("Are you sure that you want to delete selected record?", vbYesNo, "Delete Confirmation")
   
    If intResult = vbNo Then
        Cancel = True
    End If

End Sub

' 2010-04-27, JFW, Multiple points of update
Private Sub timerMPSCaption_Timer()

    Dim rsQuery As String
    Dim rsMPSCount As ADODB.Recordset
    Dim dblWeight As Double
    Dim strOrderID As String
    
    timerMPSCaption.Enabled = False
    
    On Error GoTo EH

    If f1.Text <> "" Then
        strOrderID = f1.Text
    ElseIf g_strOrderID <> "" Then
        strOrderID = g_strOrderID
    End If
    
    Set rsMPSCount = New ADODB.Recordset
    rsQuery = "SELECT * FROM MPS WHERE f1 = '" & strOrderID & "'"
    rsQuery = rsQuery & " AND Workstation = '" & g_strComputerName & "'"
    rsQuery = rsQuery & " order by ShipDate"
    rsMPSCount.Open rsQuery, g_connFSMSClient, adOpenStatic, adLockOptimistic
    Do Until rsMPSCount.EOF
        If IsNumeric(rsMPSCount!g_str1670 & "") Then
            dblWeight = dblWeight + CDbl(rsMPSCount!g_str1670 & "")
        End If
        rsMPSCount.MoveNext
    Loop
    grdMPS.Caption = "Total Packages: " & Str(rsMPSCount.RecordCount) & " for " & IIf(dblWeight = CLng(dblWeight), dblWeight, Format(dblWeight, "0.0")) & " " & frmShip.f75.Text
    ' 2012-01-12, JFW,
    If rsMPSCount.RecordCount <= 1 Then
        frmShip.f116.Text = "1"
    End If
        
Release:
    If rsMPSCount.State = adStateOpen Then rsMPSCount.Close
    Set rsMPSCount = Nothing
    
    Exit Sub
EH:
    MsgBox Err.Description, vbCritical, "frmMPS:MPSCaption"
    Resume Release
    
End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : txtNoPkgs_Change()
' DateTime  : 3/19/2004
' Purpose   : # of pkgs is numeric only
'---------------------------------------------------------------------------------------
'
Private Sub txtNoPkgs_Change()
    Call NumericOnly(txtNoPkgs, False)
End Sub
'

'---------------------------------------------------------------------------------------
' Module    : GotFocus - textboxes
' DateTime  : 8/29/2005
' Author    : Chris Elwell
' Purpose   : The subroutines below call a routine to select all text in the text box
'             passed to the sub.
'---------------------------------------------------------------------------------------
'
Private Sub f1_GotFocus()
    Call SelectAllText(f1)
End Sub

Private Sub txtNoPkgs_GotFocus()
    Call SelectAllText(txtNoPkgs)
End Sub
'Dim
Private Sub f57_GotFocus()
    Call SelectAllText(f57)
End Sub
'Dim
Private Sub f58_GotFocus()
    Call SelectAllText(f58)
End Sub
'Dim
Private Sub f59_GotFocus()
    Call SelectAllText(f59)
End Sub
'Dec Val
Private Sub f26_GotFocus()
    Call SelectAllText(f26)
End Sub
'References
Private Sub f25_GotFocus()
    Call SelectAllText(f25)
End Sub
'PO Number
Private Sub f3056_GotFocus()
    Call SelectAllText(f3056)
End Sub
'Inv Number
Private Sub f3057_GotFocus()
    Call SelectAllText(f3057)
End Sub
'---------------------------------------------------------------------------------------
'End of GotFocus event subs
'---------------------------------------------------------------------------------------

